The goal of this project was to check if age, religion, gender and previous voting preferences has an effect on how “you” vote in Brexit Referendum Vote. Multi-Group CFA was used to test out this theory. After applying those methods on the given data set, we could not come to a conclusion of singling out a particular question variable which might explain the brexit referendum voting outcome.
People of a country were always divided by their political ideas. The division was quite small until a few years ago. To explain in a graphical format. If neural ideas are a center line, the division in question is the difference in current political right to current political left. See the image below for reference (Ghosh 2019). Pundits warn, if the division continues to grow, it might cause a physical divide in the population. This trend seems to be occurring across the globe (Thomas Carothers 2019).
The reason for choosing Multi-Group Confirmatory Factor Analysis (MGCFA) is simple, in our lecture we learnt that invariance = equivalence. MGCFA satisfies the conditions mentioned in the lecture. Items act the same across the group. Factor structure is same across groups. Paths are equal across the groups. Latent means are almost equal across the groups.
This project aims to if previous vote, sex, religion and age group give variance in the Brexit voting preference. The central idea is to debunk the theory of “natural” alignment to a political party. Individual of a certain Race/Ethnicity/Age will align with a political party.
The date is provided by Dr. Erin M. Buchanan, Harrisburg University of Science and Technology and it’s explanation from a study website by Bob Altemeyer, it be found here (Altemeyer and Johnson 2020). The data is a scientific study of where do “you” lie on the Right Wing Authoritarians (RWA) scale (Altemeyer 2006)
Summary of the data after dropping unused columns.
library(lavaan)
## This is lavaan 0.6-7
## lavaan is BETA software! Please report any bugs.
library(semPlot)
library(knitr)
scoring = function(model){
round(fitmeasures(model, c("chisq", "df", "cfi", "rmsea", "srmr")),3)
}
master = read.csv("study4.csv", stringsAsFactors = T)
master = master[, c(2,8,9,12,15,16,17,18,19,39:60)]
summary(master)
## id Remove country ageGroup6Text sex
## Min. : 1 Keep :1613 GB :1560 Age 18-24:365 Female:727
## 1st Qu.: 409 Remove: 20 FR : 10 Age 25-34:232 Male :906
## Median : 817 US : 10 Age 35-44:210
## Mean : 817 ES : 5 Age 45-54:293
## 3rd Qu.:1225 GR : 5 Age 55-64:301
## Max. :1633 DE : 3 Age 65+ :232
## (Other): 40
## previousVote intendReferendumVote ethnicity religion Q1
## Labour :557 Leave :690 a:1541 Min. :1.000 Min. :1.000
## UKIP :305 NoVote: 22 b: 36 1st Qu.:1.000 1st Qu.:2.000
## Con :250 Remain:907 c: 26 Median :2.000 Median :3.000
## LibDem :182 Spoil : 14 d: 8 Mean :2.333 Mean :3.476
## Green :164 e: 22 3rd Qu.:4.000 3rd Qu.:5.000
## NoVote : 86 Max. :5.000 Max. :9.000
## (Other): 89
## Q2 Q3 Q4 Q5
## Min. :1.000 Min. :1.000 Min. :1.000 Min. :1.000
## 1st Qu.:1.000 1st Qu.:5.000 1st Qu.:1.000 1st Qu.:1.000
## Median :1.000 Median :8.000 Median :1.000 Median :3.000
## Mean :1.777 Mean :6.921 Mean :2.078 Mean :3.132
## 3rd Qu.:1.000 3rd Qu.:9.000 3rd Qu.:2.000 3rd Qu.:5.000
## Max. :9.000 Max. :9.000 Max. :9.000 Max. :9.000
##
## Q6 Q7 Q8 Q9
## Min. :1.000 Min. :1.000 Min. :1.000 Min. :1.000
## 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:1.000
## Median :1.000 Median :3.000 Median :2.000 Median :2.000
## Mean :2.277 Mean :3.628 Mean :2.691 Mean :2.484
## 3rd Qu.:3.000 3rd Qu.:6.000 3rd Qu.:4.000 3rd Qu.:3.000
## Max. :9.000 Max. :9.000 Max. :9.000 Max. :9.000
##
## Q10 Q11 Q12 Q13
## Min. :1.000 Min. :1.000 Min. :1.000 Min. :1.000
## 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:2.000 1st Qu.:1.000
## Median :3.000 Median :1.000 Median :4.000 Median :2.000
## Mean :3.851 Mean :2.134 Mean :4.366 Mean :2.798
## 3rd Qu.:6.000 3rd Qu.:3.000 3rd Qu.:6.000 3rd Qu.:4.000
## Max. :9.000 Max. :9.000 Max. :9.000 Max. :9.000
##
## Q14 Q15 Q16 Q17
## Min. :1.000 Min. :1.000 Min. :1.000 Min. :1.000
## 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:1.000
## Median :3.000 Median :3.000 Median :1.000 Median :3.000
## Mean :4.089 Mean :3.119 Mean :2.018 Mean :3.727
## 3rd Qu.:6.000 3rd Qu.:4.000 3rd Qu.:2.000 3rd Qu.:6.000
## Max. :9.000 Max. :9.000 Max. :9.000 Max. :9.000
##
## Q18 Q19 Q20 Q21
## Min. :1.000 Min. :1.000 Min. :1.000 Min. :1.000
## 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:1.000
## Median :1.000 Median :2.000 Median :2.000 Median :3.000
## Mean :1.644 Mean :3.158 Mean :2.266 Mean :3.386
## 3rd Qu.:1.000 3rd Qu.:5.000 3rd Qu.:3.000 3rd Qu.:5.000
## Max. :9.000 Max. :9.000 Max. :9.000 Max. :9.000
##
## Q22
## Min. :1.000
## 1st Qu.:1.000
## Median :2.000
## Mean :3.299
## 3rd Qu.:5.000
## Max. :9.000
##
data = subset(master, master$Remove == "Keep")
data = subset(data, data$intendReferendumVote != "Spoil")
data = subset(data, data$intendReferendumVote != "NoVote")
data = droplevels(data)
data$Vote = as.numeric(data$intendReferendumVote)-1
summary(data)
## id Remove country ageGroup6Text sex
## Min. : 1.0 Keep:1577 GB :1505 Age 18-24:352 Female:703
## 1st Qu.: 413.0 FR : 10 Age 25-34:227 Male :874
## Median : 817.0 US : 10 Age 35-44:200
## Mean : 817.5 ES : 5 Age 45-54:279
## 3rd Qu.:1225.0 GR : 4 Age 55-64:294
## Max. :1633.0 DE : 3 Age 65+ :225
## (Other): 40
## previousVote intendReferendumVote ethnicity religion Q1
## Labour :538 Leave :681 a:1491 Min. :1.000 Min. :1.000
## UKIP :298 Remain:896 b: 34 1st Qu.:1.000 1st Qu.:2.000
## Con :242 c: 24 Median :2.000 Median :3.000
## LibDem :179 d: 7 Mean :2.325 Mean :3.489
## Green :157 e: 21 3rd Qu.:4.000 3rd Qu.:5.000
## NoVote : 76 Max. :5.000 Max. :9.000
## (Other): 87
## Q2 Q3 Q4 Q5 Q6
## Min. :1.00 Min. :1.000 Min. :1.000 Min. :1.000 Min. :1.000
## 1st Qu.:1.00 1st Qu.:5.000 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:1.000
## Median :1.00 Median :9.000 Median :1.000 Median :3.000 Median :1.000
## Mean :1.76 Mean :6.937 Mean :2.064 Mean :3.124 Mean :2.261
## 3rd Qu.:1.00 3rd Qu.:9.000 3rd Qu.:2.000 3rd Qu.:5.000 3rd Qu.:3.000
## Max. :9.00 Max. :9.000 Max. :9.000 Max. :9.000 Max. :9.000
##
## Q7 Q8 Q9 Q10
## Min. :1.000 Min. :1.000 Min. :1.000 Min. :1.000
## 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:1.000
## Median :3.000 Median :2.000 Median :2.000 Median :3.000
## Mean :3.635 Mean :2.679 Mean :2.469 Mean :3.856
## 3rd Qu.:6.000 3rd Qu.:4.000 3rd Qu.:3.000 3rd Qu.:6.000
## Max. :9.000 Max. :9.000 Max. :9.000 Max. :9.000
##
## Q11 Q12 Q13 Q14
## Min. :1.000 Min. :1.000 Min. :1.000 Min. :1.000
## 1st Qu.:1.000 1st Qu.:2.000 1st Qu.:1.000 1st Qu.:1.000
## Median :1.000 Median :4.000 Median :2.000 Median :4.000
## Mean :2.136 Mean :4.375 Mean :2.788 Mean :4.098
## 3rd Qu.:3.000 3rd Qu.:6.000 3rd Qu.:4.000 3rd Qu.:6.000
## Max. :9.000 Max. :9.000 Max. :9.000 Max. :9.000
##
## Q15 Q16 Q17 Q18 Q19
## Min. :1.000 Min. :1 Min. :1.000 Min. :1.000 Min. :1.00
## 1st Qu.:1.000 1st Qu.:1 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:1.00
## Median :3.000 Median :1 Median :3.000 Median :1.000 Median :2.00
## Mean :3.113 Mean :2 Mean :3.706 Mean :1.628 Mean :3.15
## 3rd Qu.:4.000 3rd Qu.:2 3rd Qu.:6.000 3rd Qu.:1.000 3rd Qu.:5.00
## Max. :9.000 Max. :9 Max. :9.000 Max. :9.000 Max. :9.00
##
## Q20 Q21 Q22 Vote
## Min. :1.000 Min. :1.000 Min. :1.000 Min. :0.0000
## 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:0.0000
## Median :2.000 Median :3.000 Median :2.000 Median :1.0000
## Mean :2.255 Mean :3.384 Mean :3.292 Mean :0.5682
## 3rd Qu.:3.000 3rd Qu.:5.000 3rd Qu.:5.000 3rd Qu.:1.0000
## Max. :9.000 Max. :9.000 Max. :9.000 Max. :1.0000
##
For the theory we want to test, all the question are tied to a variable and that variable will predict the voting preference.
Checking to see if Gender has any role on the voting preference.
gender.fit.female = cfa(model = brexit.model, data = data[data$sex == "Female",], meanstructure = T)
gender.fit.male = cfa(model = brexit.model, data = data[data$sex == "Male",], meanstructure = T)
gender.configural.fit = cfa(model = brexit.model, data = data, meanstructure = T, group = "sex")
gender.metric.fit = cfa(model = brexit.model, data = data, meanstructure = T, group = "sex", group.equal = c("loadings"))
gender.scalar.fit = cfa(model = brexit.model, data = data, meanstructure = T, group = "sex", group.equal = c("loadings", "intercepts"))
gender.strict.fit = cfa(model = brexit.model, data = data, meanstructure = T, group = "sex", group.equal = c("loadings", "intercepts", "residuals"))
gender_partial_syntax = paste(colnames(data)[10:31], "~~", colnames(data)[10:31])
gender_CFI_list <- 1:length(gender_partial_syntax)
names(gender_CFI_list) <- gender_partial_syntax
for (i in 1:length(gender_partial_syntax)){
temp <- cfa(model = brexit.model,
data = data,
meanstructure = TRUE,
group = "sex",
group.equal = c("loadings", "intercepts", "residuals"),
group.partial = gender_partial_syntax[i])
gender_CFI_list[i] <- fitmeasures(temp, "cfi")
}
gender.partial.fit <- cfa(model = brexit.model, data = data, meanstructure = TRUE, group = "sex", group.equal = c("loadings", "intercepts", "residuals"), group.partial = names(which.max(gender_CFI_list)))
| Model | X2 | df | CFI | RMSEA | SRMR |
|---|---|---|---|---|---|
| Overall Model | 5542.804 | 230 | 0.698 | 0.121 | 0.108 |
| Female Gender Model | 3210.014 | 230 | 0.635 | 0.136 | 0.127 |
| Male Gender Model | 2817.605 | 230 | 0.733 | 0.113 | 0.097 |
| Gender Configural Model | 6027.62 | 460 | 0.688 | 0.124 | 0.11 |
| Gender Metric Model | 6082.895 | 481 | 0.686 | 0.122 | 0.113 |
| Gender Scalar Model | 6264.688 | 503 | 0.678 | 0.121 | 0.114 |
| Gender Strict Model | 6391.618 | 526 | 0.672 | 0.119 | 0.116 |
| Gender Partial Invariance Model | 6361.703 | 525 | 0.673 | 0.119 | 0.115 |
Checking to see if religion plays a role in voting preference.
rel.one.model = cfa(model = brexit.model, data = data[data$religion == 1,], meanstructure = T)
rel.two.model = cfa(model = brexit.model, data = data[data$religion == 2,], meanstructure = T)
rel.three.model = cfa(model = brexit.model, data = data[data$religion == 3,], meanstructure = T)
rel.four.model = cfa(model = brexit.model, data = data[data$religion == 4,], meanstructure = T)
rel.five.model = cfa(model = brexit.model, data = data[data$religion == 5,], meanstructure = T)
rel.configural.fit = cfa(model = brexit.model, data = data, meanstructure = T, group = "religion")
rel.metric.fit = cfa(model = brexit.model, data = data, meanstructure = T, group = "religion", group.equal = c("loadings"))
rel.scalar.fit = cfa(model = brexit.model, data = data, meanstructure = T, group = "religion", group.equal = c("loadings", "intercepts"))
rel.strict.fit = cfa(model = brexit.model, data = data, meanstructure = T, group = "religion", group.equal = c("loadings", "intercepts", "residuals"))
rel_partial_syntax = paste(colnames(data)[10:31], "~~", colnames(data)[10:31])
rel_CFI_list <- 1:length(rel_partial_syntax)
names(rel_CFI_list) <- rel_partial_syntax
for (i in 1:length(rel_partial_syntax)){
temp <- cfa(model = brexit.model,
data = data,
meanstructure = TRUE,
group = "religion",
group.equal = c("loadings", "intercepts", "residuals"),
group.partial = rel_partial_syntax[i])
rel_CFI_list[i] <- fitmeasures(temp, "cfi")
}
rel.partial.fit <- cfa(model = brexit.model, data = data, meanstructure = TRUE, group = "religion", group.equal = c("loadings", "intercepts", "residuals"), group.partial = names(which.max(rel_CFI_list)))
| Model | X2 | df | CFI | RMSEA | SRMR |
|---|---|---|---|---|---|
| Overall Model | 5542.804 | 230 | 0.698 | 0.121 | 0.108 |
| Religion(1) Model | 1971.328 | 230 | 0.733 | 0.1 | 0.089 |
| Religion(2) Model | 674.461 | 230 | 0.712 | 0.111 | 0.086 |
| Religion(3) Model | 1224.211 | 230 | 0.597 | 0.134 | 0.148 |
| Religion(4) Model | 1236.903 | 230 | 0.665 | 0.129 | 0.123 |
| Religion(5) Model | 1167.258 | 230 | 0.586 | 0.157 | 0.144 |
| Religion Configural Model | 6274.161 | 1150 | 0.676 | 0.119 | 0.109 |
| Religion Metric Model | 6515.192 | 1234 | 0.666 | 0.116 | 0.121 |
| Religion Scalar Model | 7120.566 | 1322 | 0.633 | 0.118 | 0.123 |
| Religion Strict Model | 8382.156 | 1414 | 0.559 | 0.125 | 0.151 |
| Religion Partial Invariance Model | 8175.329 | 1410 | 0.572 | 0.123 | 0.141 |
Checking to see if age groups play a role in voting preference.
age.one.fit = cfa(model = brexit.model, data = data[data$ageGroup6Text == "Age 18-24",], meanstructure = T)
age.two.fit = cfa(model = brexit.model, data = data[data$ageGroup6Text == "Age 25-34",], meanstructure = T)
age.three.fit = cfa(model = brexit.model, data = data[data$ageGroup6Text == "Age 35-44",], meanstructure = T)
age.four.fit = cfa(model = brexit.model, data = data[data$ageGroup6Text == "Age 45-54",], meanstructure = T)
age.five.fit = cfa(model = brexit.model, data = data[data$ageGroup6Text == "Age 55-64",], meanstructure = T)
age.six.fit = cfa(model = brexit.model, data = data[data$ageGroup6Text == "Age 65+",], meanstructure = T)
age.configural.fit = cfa(model = brexit.model, data = data, meanstructure = T, group = "ageGroup6Text")
age.metric.fit = cfa(model = brexit.model, data = data, meanstructure = T, group = "ageGroup6Text", group.equal = c("loadings"))
age.scalar.fit = cfa(model = brexit.model, data = data, meanstructure = T, group = "ageGroup6Text", group.equal = c("loadings", "intercepts"))
age.strict.fit = cfa(model = brexit.model, data = data, meanstructure = T, group = "ageGroup6Text", group.equal = c("loadings", "intercepts", "residuals"))
age_partial_syntax = paste(colnames(data)[10:31], "~~", colnames(data)[10:31])
age_CFI_list <- 1:length(age_partial_syntax)
names(age_CFI_list) <- age_partial_syntax
for (i in 1:length(age_partial_syntax)){
temp <- cfa(model = brexit.model,
data = data,
meanstructure = TRUE,
group = "ageGroup6Text",
group.equal = c("loadings", "intercepts", "residuals"),
group.partial = age_partial_syntax[i])
age_CFI_list[i] <- fitmeasures(temp, "cfi")
}
age.partial.fit <- cfa(model = brexit.model, data = data, meanstructure = TRUE, group = "ageGroup6Text", group.equal = c("loadings", "intercepts", "residuals"), group.partial = names(which.max(age_CFI_list)))
| Model | X2 | df | CFI | RMSEA | SRMR |
|---|---|---|---|---|---|
| Overall Model | 5542.804 | 230 | 0.698 | 0.121 | 0.108 |
| Age Group (18-24) Model | 1355.441 | 230 | 0.757 | 0.118 | 0.081 |
| Age Group (25-34) Model | 926.648 | 230 | 0.662 | 0.116 | 0.099 |
| Age Group (35-44) Model | 940.729 | 230 | 0.725 | 0.124 | 0.1 |
| Age Group (45-54) Model | 1169.411 | 230 | 0.682 | 0.121 | 0.102 |
| Age Group (55-64) Model | 1494.714 | 230 | 0.597 | 0.137 | 0.15 |
| Age Group (65+) Model | 1344.977 | 230 | 0.556 | 0.147 | 0.171 |
| Age Group Configural Model | 7231.92 | 1380 | 0.673 | 0.127 | 0.115 |
| Age Group Metric Model | 7619.473 | 1485 | 0.657 | 0.125 | 0.13 |
| Age Group Scalar Model | 8070.001 | 1595 | 0.638 | 0.124 | 0.134 |
| Age Group Strict Model | 9675.02 | 1710 | 0.554 | 0.133 | 0.153 |
| Age Group Partial Invariance Model | 9460.732 | 1705 | 0.566 | 0.132 | 0.15 |
data = subset(data, data$previousVote != "Cymru")
data = droplevels(data)
UKIP.fit = cfa(model = brexit.model, data = data[data$previousVote == "UKIP",], meanstructure = T)
SNP.fit = cfa(model = brexit.model, data = data[data$previousVote == "SNP",], meanstructure = T)
NoVote.fit = cfa(model = brexit.model, data = data[data$previousVote == "NoVote",], meanstructure = T)
LibDem.fit = cfa(model = brexit.model, data = data[data$previousVote == "LibDem",], meanstructure = T)
Labour.fit = cfa(model = brexit.model, data = data[data$previousVote == "Labour",], meanstructure = T)
Green.fit = cfa(model = brexit.model, data = data[data$previousVote == "Green",], meanstructure = T)
Con.fit = cfa(model = brexit.model, data = data[data$previousVote == "Con",], meanstructure = T)
pv.configural.fit = cfa(model = brexit.model, data = data, meanstructure = T, group = "previousVote")
pv.metric.fit = cfa(model = brexit.model, data = data, meanstructure = T, group = "previousVote", group.equal = c("loadings"))
pv.scalar.fit = cfa(model = brexit.model, data = data, meanstructure = T, group = "previousVote", group.equal = c("loadings", "intercepts"))
pv.strict.fit = cfa(model = brexit.model, data = data, meanstructure = T, group = "previousVote", group.equal = c("loadings", "intercepts", "residuals"))
pv_partial_syntax = paste(colnames(data)[10:31], "~~", colnames(data)[10:31])
pv_CFI_list <- 1:length(pv_partial_syntax)
names(pv_CFI_list) <- pv_partial_syntax
for (i in 1:length(pv_partial_syntax)){
temp <- cfa(model = brexit.model,
data = data,
meanstructure = TRUE,
group = "previousVote",
group.equal = c("loadings", "intercepts", "residuals"),
group.partial = pv_partial_syntax[i])
pv_CFI_list[i] <- fitmeasures(temp, "cfi")
}
pv.partial.fit <- cfa(model = brexit.model, data = data, meanstructure = TRUE, group = "previousVote", group.equal = c("loadings", "intercepts", "residuals"), group.partial = names(which.max(pv_CFI_list)))
| Model | X2 | df | CFI | RMSEA | SRMR |
|---|---|---|---|---|---|
| Overall Model | 5542.804 | 230 | 0.698 | 0.121 | 0.108 |
| UKIP Model | 1714.059 | 230 | 0.441 | 0.147 | 0.163 |
| SNP Model | 496.966 | 230 | 0.524 | 0.124 | 0.127 |
| NoVote Model | 489.806 | 230 | 0.612 | 0.122 | 0.118 |
| LibDem Model | 726.646 | 230 | 0.647 | 0.11 | 0.099 |
| Labour Model | 1319.282 | 230 | 0.741 | 0.094 | 0.082 |
| Green Model | 697.766 | 230 | 0.735 | 0.114 | 0.083 |
| Con Model | 1225.77 | 230 | 0.582 | 0.134 | 0.136 |
| Previous Vote Configural Model | 6670.295 | 1610 | 0.629 | 0.119 | 0.112 |
| Previous Vote Metric Model | 7221.5 | 1736 | 0.598 | 0.119 | 0.13 |
| Previous Vote Scalar Model | 8636.344 | 1868 | 0.504 | 0.127 | 0.241 |
| Previous Vote Strict Model | 11183.985 | 2006 | 0.327 | 0.143 | 0.377 |
| Previous Vote Partial Model | 10899.608 | 2000 | 0.348 | 0.141 | 0.373 |
The brexit referendum vote was almost a 50-50 vote. This model somewhat replicates that. We don’t see a clear division. The results are all over the place. The fit measure scores are bad but not terrible, but they aren’t good either.
As is the case with all analysis, more data could have normalized or spread out the variable to get maybe more accurate results.
Altemeyer, Bob. 2006. “Chapter 1.” In The Authoritarians. University of Manitoba. https://web.archive.org/web/20160824064748/http://members.shaw.ca/jeanaltemeyer/drbob/chapter1.pdf.
Altemeyer, Bob, and Chris W Johnson. 2020. The RWA Scale. http://www.panojohnson.com/automatons/rwa-scale.xhtml.
Ghosh, Iman. 2019. “Charts: America’s Political Divide, 1994–2017.” Visual Capitalist. https://www.visualcapitalist.com/charts-americas-political-divide-1994-2017/.
Thomas Carothers, Andrew O’Donohue. 2019. “How to Understand the Global Spread of Political Polarization.” Carnegie Endowment for International Peace. https://carnegieendowment.org/2019/10/01/how-to-understand-global-spread-of-political-polarization-pub-79893.